home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Utilities Professional 1-1500
/
Utilities Professional 1-1500 (1994)(WPD)[!].iso
/
00010250
/
var0042.dms
/
var0042.adf
/
utilities
/
AntiFlicker.mod
< prev
next >
Wrap
Text File
|
1990-08-12
|
7KB
|
242 lines
(**********************************************************************
:Program. AntiFlicker.mod
:Contents. software solution against flickering in interlace mode
:Author. Nicolas Benezan [bne]
:Address. Postwiesenstr. 2, D7000 Stuttgart 60
:Support. copied most parts of "WBShadow" from Fridtjof Siebert
:Copyright. Public Domain
:Language. Modula-2
:Translator. M2Amiga A+L V3.2d
:Imports. TaskMemory [bne]
:History. V1.0 [bne] 19.May.1989
:History. V1.1 [bne] 31.Aug.1989 (bugs fixed)
:History. V1.2 [bne] 01.Sep.1989 (works with 2 planes, optional)
:History. V1.3 [bne] 03.Sep.1989 (+ "-c"-option)
:Usage. AntiFlicker [-c]
**********************************************************************)
MODULE AntiFlicker;
FROM Arguments IMPORT NumArgs, GetArg;
FROM Arts IMPORT Assert, Terminate, TermProcedure;
FROM Dos IMPORT Delay;
FROM Exec IMPORT AllocMem, CopyMemQuick, FindPort, Forbid,
FreeMem, GetMsg, MemReqs, MemReqSet, Message,
MessagePtr, MsgPortPtr, NodeType, Permit, PutMsg,
ReplyMsg, WaitPort;
FROM ExecSupport IMPORT CreatePort, DeletePort;
FROM Graphics IMPORT BitMap, BltClear;
FROM Intuition IMPORT CloseWindow, IDCMPFlagSet, MakeScreen, NewWindow,
OpenWindow, RethinkDisplay, ScreenFlags,
ScreenFlagSet, ScreenPtr, WindowFlags,
WindowFlagSet, WindowPtr;
FROM SYSTEM IMPORT ADDRESS, ADR, BITSET, CAST, SHIFT;
CONST
WindowTitle = "AntiFlicker © AMOK Stuttgart [fbs]+[bne]";
PortName = "NewWBPlanes[fbs].Port";
ReplyName = "NewWBPlanes[fbs].ReplyPort";
TYPE
ColorTable=ARRAY [0..31] OF CARDINAL;
ColorTablePtr=POINTER TO ColorTable;
VAR
WBScreen: ScreenPtr;
OldPlane: ADDRESS;
Window: WindowPtr;
MyMsg: Message;
QuitMessage: MessagePtr;
MyPort: MsgPortPtr;
OldColorPtr: ColorTablePtr;
NewColors: ColorTable;
ColorOption: BOOLEAN;
Arg: ARRAY [0..2] OF CHAR;
Len: INTEGER;
PROCEDURE CheckPublicPort;
VAR
OldPort:MsgPortPtr;
BEGIN
OldPort:= FindPort(ADR(PortName));
IF OldPort#NIL THEN
MyPort:= CreatePort(ADR(ReplyName),0);
Assert(MyPort#NIL,ADR("CreatePort failed"));
MyMsg.node.type:= message;
MyMsg.replyPort:= MyPort;
PutMsg(OldPort,ADR(MyMsg)); (* Signal task to quit *)
WaitPort(MyPort);
DeletePort(MyPort);
MyPort:= NIL;
Terminate(0);
END;
MyPort:= CreatePort(ADR(PortName),0);
Assert(MyPort#NIL,ADR("CreatePort failed"));
END CheckPublicPort;
PROCEDURE InitWindow;
VAR
NuWindow: NewWindow;
BEGIN
WITH NuWindow DO
leftEdge := 0;
topEdge := 0;
width := 1;
height := 1;
detailPen := 0;
blockPen := 1;
idcmpFlags := IDCMPFlagSet{};
flags := WindowFlagSet{backDrop};
firstGadget:= NIL;
checkMark := NIL;
title := ADR(WindowTitle);
screen := NIL;
bitMap := NIL;
type := ScreenFlagSet{wbenchScreen};
END;
Window:= OpenWindow(NuWindow);
Assert(Window#NIL,ADR("Can't open Window!!!"));
WBScreen:= Window^.wScreen;
IF WBScreen^.bitMap.depth>2 THEN
Terminate(0)
END; (* thers sth. strange ! *)
END InitWindow;
PROCEDURE SetPlanes(AddPlane: BOOLEAN);
VAR
RasSize: LONGINT;
NewPlane: ADDRESS;
Color: CARDINAL;
PROCEDURE Mix(Color1, Color2: CARDINAL): CARDINAL;
BEGIN
RETURN SHIFT(CAST(CARDINAL, CAST(BITSET, Color1)-{0,4,8})+
CAST(CARDINAL, CAST(BITSET, Color2)-{0,4,8}), -1);
END Mix;
BEGIN
WITH WBScreen^ DO
WITH bitMap DO
RasSize:=LONGINT(bytesPerRow)*LONGINT(rows);
Forbid;
IF NOT AddPlane THEN
FreeMem(planes[1], RasSize);
depth:=1;
END;
NewPlane:=AllocMem(RasSize+LONGINT(bytesPerRow),
MemReqSet{chip});
IF NewPlane#NIL THEN
CopyMemQuick(planes[0], NewPlane, RasSize);
BltClear(NewPlane+RasSize, bytesPerRow, 0);
FreeMem(planes[0], RasSize);
planes[0]:=NewPlane;
END;
planes[depth]:=NewPlane;
INC(planes[depth], bytesPerRow);
END;
OldColorPtr:=viewPort.colorMap^.colorTable;
FOR Color:=0 TO 31 DO
NewColors[Color]:=OldColorPtr^[Color];
END;
IF AddPlane THEN
NewColors[1]:=Mix(OldColorPtr^[0], OldColorPtr^[1]);
NewColors[4]:=NewColors[1];
NewColors[5]:=OldColorPtr^[1];
NewColors[2]:=OldColorPtr^[2];
NewColors[3]:=Mix(OldColorPtr^[0], OldColorPtr^[3]);
NewColors[6]:=NewColors[3];
NewColors[7]:=OldColorPtr^[3];
ELSE
NewColors[1]:=Mix(OldColorPtr^[0], OldColorPtr^[1]);
NewColors[2]:=NewColors[1];
NewColors[3]:=OldColorPtr^[1];
END;
Permit;
END;
END SetPlanes;
PROCEDURE UnsetPlanes;
VAR
RasSize: LONGINT;
BEGIN
WITH WBScreen^ DO
WITH bitMap DO
RasSize:=LONGINT(bytesPerRow)*LONGINT(rows);
Forbid();
IF planes[0]=planes[depth]-LONGINT(bytesPerRow) THEN
FreeMem(planes[0]+RasSize, bytesPerRow);
END;
IF depth=1 THEN
planes[1]:=AllocMem(RasSize, MemReqSet{chip});
IF planes[1]#NIL THEN
BltClear(planes[1], RasSize, 0);
depth:=2;
END;
END;
END;
Permit();
END;
MakeScreen(WBScreen);
RethinkDisplay;
END UnsetPlanes;
PROCEDURE CleanUp();
BEGIN
IF WBScreen#NIL THEN
UnsetPlanes;
RethinkDisplay();
END;
IF Window#NIL THEN CloseWindow(Window); END;
IF MyPort#NIL THEN
Forbid();
IF QuitMessage=NIL THEN
QuitMessage := GetMsg(MyPort)
END;
WHILE QuitMessage#NIL DO
ReplyMsg(QuitMessage);
QuitMessage := GetMsg(MyPort);
END;
DeletePort(MyPort);
Permit();
END;
END CleanUp;
PROCEDURE InitTermProc;
BEGIN
WBScreen:= NIL;
Window:= NIL;
MyPort:= NIL;
TermProcedure(CleanUp);
END InitTermProc;
BEGIN
InitTermProc;
CheckPublicPort;
InitWindow;
ColorOption:=FALSE;
IF NumArgs()>0 THEN
GetArg(1, Arg, Len);
IF (Arg[0]="-") AND (CAP(Arg[1])="C") AND (Len=2) THEN
ColorOption:=TRUE;
END;
END;
SetPlanes(ColorOption);
WITH WBScreen^.bitMap DO
REPEAT
Forbid();
INC(depth);
WBScreen^.viewPort.colorMap^.colorTable:=ADR(NewColors);
MakeScreen(WBScreen);
DEC(depth);
WBScreen^.viewPort.colorMap^.colorTable:=OldColorPtr;
Permit();
RethinkDisplay();
Delay(16);
QuitMessage:=GetMsg(MyPort);
UNTIL QuitMessage#NIL;
END;
END AntiFlicker.